home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr05
/
tpwplay.zip
/
CDINFO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-13
|
7KB
|
267 lines
library CDInfo;
{
Programmer: Charlie Calvert
Thanks: Mark C. Paxton
Copyright (c) June 1993, by Charlie Calvert
Feel free to use this code as an adjunct to your own programs.
}
uses
MMSystem,
PlayInfo,
Strings,
WinProcs,
WinTypes;
function OpenCD(PWindow: HWnd): Boolean; export;
var
Info : TMCI_Open_Parms;
RC : LongInt;
Flags: LongInt;
S1: array[0..MsgLen] of Char;
begin
OpenCD := True;
FillChar(Info, SizeOf(TMCI_Open_Parms), #0);
Info.dwCallback := PWindow;
Info.lpstrDeviceType:=PChar(MCI_DEVTYPE_CD_AUDIO);
Flags := MCI_OPEN_TYPE or MCI_OPEN_TYPE_ID;
RC := mciSendCommand(0, MCI_OPEN, Flags, Longint(@Info));
wDeviceId := Info.wDeviceId;
if RC<>0 then begin
ErrorMsg(RC, S1);
OpenCD := False;
end;
end;
procedure SetMSFasFormat; export;
var
Info: TMCI_Set_Parms;
RC : LongInt;
S1 : array[0..MsgLen] of Char;
begin
Info.dwCallback := 0;
Info.dwTimeFormat := MCI_FORMAT_MSF;
Info.dwAudio := 0;
RC:=mciSendCommand( wDeviceId,
MCI_SET,
MCI_SET_TIME_FORMAT,
Longint(@Info));
if RC<>0 then ErrorMsg(RC, S1);
end;
procedure SetTMSFasFormat; export;
var
Info: TMCI_Set_Parms;
RC : LongInt;
S1 : array[0..MsgLen] of Char;
begin
Info.dwCallback := 0;
Info.dwTimeFormat := MCI_FORMAT_TMSF;
Info.dwAudio := 0;
RC:=mciSendCommand( wDeviceId, MCI_SET,
MCI_SET_TIME_FORMAT, Longint(@Info));
if RC<>0 then ErrorMsg(RC, S1);
end;
procedure PlayCDOneTrack(StartTrack:Byte); export;
var
Info : TMCI_Play_Parms;
Flags,
RC : LongInt;
S1 : array[0..MsgLen] of Char;
begin
FillChar(Info, SizeOf(TMCI_Play_Parms), 0);
Info.dwFrom := MCI_MAKE_TMSF(StartTrack,0,0,0);
Flags := MCI_FROM or MCI_Notify;
RC := mciSendCommand( wDeviceId, MCI_PLAY, Flags, Longint(@Info));
if RC<>0 then ErrorMsg(RC, S1);
end;
procedure PlayMciCD(StartTrack,EndTrack:Byte); export;
var
Info : TMCI_Play_Parms;
Flags,
RC : LongInt;
S1 : array[0..MsgLen] of Char;
begin
FillChar(Info, SizeOf(TMCI_Play_Parms), 0);
Info.dwFrom := MCI_MAKE_TMSF(StartTrack,0,0,0);
Info.dwTo := MCI_MAKE_TMSF(EndTrack, 0,0,0);
Flags := MCI_FROM or MCI_TO or MCI_Notify;
RC := mciSendCommand(wDeviceId, MCI_PLAY, Flags, Longint(@Info));
if RC<>0 then ErrorMsg(RC, S1);
end;
function GetNumTracks: LongInt; export;
var
Status: TMCI_Status_Parms;
RC : LongInt;
S1 : array[0..MsgLen] of Char;
begin
Status.dwCallback := 0;
Status.dwReturn := 0;
Status.dwItem := MCI_STATUS_NUMBER_OF_TRACKS;
Status.dwTrack := 0;
RC := mciSendCommand(wDeviceId, MCI_STATUS,
MCI_STATUS_ITEM, Longint(@Status));
if RC<>0 then ErrorMsg(RC, S1);
GetNumTracks := Status.dwReturn;
end;
{---------------------------------------------------------------
Track information is stated in minutes and seconds relative
to the beginning of the disc. The durations of each song can
be constructed by subtracting the begin time of a song from the
begin time of the previous song.
----------------------------------------------------------------}
procedure GetTrackLength(TrackNum: LongInt; var Min, Sec, Frame: Byte); export;
var
Status : TMCI_Status_Parms;
RC : LongInt;
MSF : LongInt;
MessageText : array[0..128] of Char;
begin
Status.dwTrack := TrackNum;
Status.dwCallback := 0;
Status.dwReturn := 0;
Status.dwItem := MCI_STATUS_LENGTH;
RC := mciSendCommand(wDeviceId, MCI_STATUS,
MCI_STATUS_ITEM or MCI_TRACK,
Longint(@Status));
if RC <> 0 then ErrorMsg(RC, 'Could not get track length');
MSF :=Status.dwReturn;
Min := MCI_MSF_MINUTE(MSF);
Sec := MCI_MSF_SECOND(MSF);
Frame := MCI_MSF_FRAME(MSF);
end;
{---------------------------------------------------------------
----------------------------------------------------------------}
procedure GetLengthOfEachTrack(TrackNum: LongInt; Min, Sec, Frame: Byte);
var
Status: TMCI_Status_Parms;
RC,
Flags,
MSF : LongInt;
S1 : array[0..128] of Char;
begin
MessageBox(0, 'Function not ready', '', mb_Ok);
exit;
Status.dwTrack := TrackNum;
Status.dwCallback := 0;
Status.dwReturn := 0;
Status.dwItem := MCI_STATUS_LENGTH;
Flags := MCI_STATUS_ITEM or MCI_TRACK;
RC := mciSendCommand( wDeviceId, MCI_STATUS, Flags, Longint(@Status));
if RC<>0 then begin
ErrorMsg(RC, S1);
exit;
end;
MSF:=Status.dwReturn;
Min := MCI_MSF_MINUTE(MSF);
Sec := MCI_MSF_SECOND(MSF);
Frame := MCI_MSF_FRAME(MSF);
end;
{ GetCurrentTrack; }
function GetCurrentCDTrack: LongInt; export;
{
TMCI_Status_Parms = record
dwCallback: Longint;
dwReturn: Longint;
dwItem: Longint;
dwTrack: Longint;
end;
}
var
Status : TMCI_Status_Parms;
RC : LongInt;
S1 : array[0..MsgLen] of Char;
begin
FillChar(Status, SizeOf(Status), #0);
Status.dwItem := MCI_STATUS_CURRENT_TRACK;
RC := mciSendCommand(wDeviceId, MCI_STATUS,
MCI_STATUS_ITEM, Longint(@Status));
if RC<>0 then ErrorMsg(RC, S1);
GetCurrentCDTrack := Status.dwReturn;
end;
function HasDiskInserted: Boolean; export;
var
Status : TMCI_Status_Parms;
RC : LongInt;
Flags : LongInt;
S1 : array[0..MsgLen] of Char;
begin
FillChar(Status, SizeOf(TMCI_Status_Parms), 0);
Status.dwItem := MCI_STATUS_MEDIA_PRESENT;
Flags := MCI_STATUS_ITEM;
RC:=mciSendCommand(wDeviceID, MCI_STATUS, Flags, Longint(@Status));
if RC<>0 then ErrorMsg(RC, S1);
HasDiskInserted := (Status.dwReturn > 0);
end;
procedure EjectCD;
var
Info : TMCI_Set_Parms;
Flags,
RC : LongInt;
S1 : array[0..128] of Char;
begin
FillChar(Info, SizeOf(TMCI_Set_Parms), 0);
Flags := mci_Set_Door_Open;
RC:=mciSendCommand( wDeviceId, MCI_SET, Flags, Longint(@Info));
if RC<>0 then ErrorMsg(RC, S1);
end;
exports
OpenCD index 1,
SetMSFasFormat index 2,
SetTMSFasFormat index 3,
PlayMciCD index 4,
GetNumTracks index 5,
GetTrackLength index 6,
StopMci index 7,
CloseMci index 8,
HasDiskInserted index 9,
GetDeviceID index 10,
PlayCDOneTrack index 11,
GetMode index 12,
GetCurrentCDTrack index 13,
GetLocation index 14;
begin
end.